home *** CD-ROM | disk | FTP | other *** search
- unit LBoxTab;
-
- interface
-
- uses
- StdCtrls, Controls, Classes;
-
- type
- TTabListbox = class(TListbox)
- private
- FTabStopSupport: Boolean;
- FScrollWidth: Word;
- protected
- procedure CreateParams(var Params: TCreateParams); override;
- procedure SetTabStopSupport(Value: Boolean);
- public
- function SetTabStops(Tabs: array of Integer): Boolean;
- published
- property TabStopSupport: Boolean
- read FTabStopSupport write SetTabStopSupport
- default False;
- { Note this property has been given a default of False
- but that value is not being assigned to FTabStopSupport
- since it will get that value anyway. All class data
- fields are initialised with zero memory byte values }
- end;
-
- procedure Register;
-
- implementation
-
- uses
- WinTypes, Messages;
-
- procedure TTabListbox.CreateParams(var Params: TCreateParams);
- const
- TabStopSupport: array[Boolean] of Longint = (0, lbs_UseTabStops);
- begin
- inherited CreateParams(Params);
- Params.Style := Params.Style or TabStopSupport[FTabStopSupport];
- end;
-
- procedure TTabListbox.SetTabStopSupport(Value: Boolean);
- begin
- if Value <> FTabStopSupport then
- begin
- FTabStopSupport := Value;
- RecreateWnd;
- end;
- end;
-
- function TTabListbox.SetTabStops(Tabs: array of Integer): Boolean;
- begin
- Result := Perform(lb_SetTabStops, High(Tabs) - Low(Tabs) + 1,
- Longint(@Tabs)) <> 0;
- if Result then
- Repaint;
- end;
-
- procedure Register;
- begin
- RegisterComponents('Clinic', [TTabListBox]);
- end;
-
- end.
-